open Utils.RandSelect
open Utils.Pervasive
open Utils.ListSpecial
open Syntax
open Binding
open PrintExpr
open GPUtils

open BlockPopulation.GenePool


open BlockPopulationVisual
open Expr_visual
open Pointers
open TestCases
open ProofAssembler

open Population.Genotypes
open Population.Species
open Population.GP
open Population.GPRun 

open ProofVisual
open Lowlevelgraph.AntEnv 

open List
open Gobject.Data
open Core
open StdLabels
open GtkTree


module EvaluatingFunction = struct
	
	let antClock = ref 0
	let manClock = ref 0.
	let ticker ( ) = 
		match !antClock, Unix.time( ) with 
		| 0 , _ -> 
			manClock := Unix.time( );prf "\n|"; antClock := !antClock + 1; true
		| x , y when x > 200 || y > !manClock +. 100.->
			prf "\n";antClock := 0;false
		| _  -> 
			antClock := !antClock + 1;
			prf "|";true
			
			
			
	let evaluation_function ctx = 
		let max = 60. in 
		EvalFunc(max , fun ter -> playAnt ~visual:false ticker max ctx ter)
end 

open EvaluatingFunction
module InOutEco = struct
    let save_eco eco ( )= 
		let save_to_out ps_file = 
			let oc = open_out_bin  ps_file in
			Marshal.to_channel oc eco.solutions [];
			Marshal.to_channel oc eco.species_count [];
			Marshal.to_channel oc eco.generation_count [];
			Marshal.to_channel oc eco.stats [];
			Marshal.to_channel oc eco.fossil_record [];
			Marshal.to_channel oc eco.settings [];
			Marshal.to_channel oc eco.goal_type []; 
			Marshal.to_channel oc !(eco.genes) []; 
			Marshal.to_channel oc eco.kingdom [];  
			close_out oc in
	
		let file_ok_sel filew ( ) =
			let ps_file =  filew#filename in
			save_to_out ps_file;
			filew#destroy( ) in
	
		let filew = GWindow.file_selection 
			~title:"Saving ecosystem" 
			~border_width:10  () in
		un (filew#ok_button#connect#clicked 
			~callback:(file_ok_sel filew));
		un (filew#cancel_button#connect#clicked 
			~callback:filew#destroy);
		filew#show()  		
	let open_eco eco_ref ( )=
		let open_from_in ps_file = 
			let ic = open_in_bin  ps_file in
			let  (solutions  : term list) = Marshal.from_channel ic in
			let (species_count : int) = Marshal.from_channel ic in
			let (generation_count : int) =  Marshal.from_channel ic in
			let (stats : string) = Marshal.from_channel ic in
			let (fossil_record : (Proof.proof , int option) Hashtbl.t) = Marshal.from_channel ic in
			let (settings : ecoSetting) = Marshal.from_channel ic in
			let (goal_type : ty)= Marshal.from_channel ic in
			let (genes : gene_pool)= Marshal.from_channel ic in  
			let (kingdom : (Proof.proof,  population) Hashtbl.t )= Marshal.from_channel ic in
			let ge = evaluation_function !(genes.ctx) in	
			let eco = 	{
				solutions = solutions;
				species_count = species_count;
				generation_count = generation_count;
				stats = stats;
				fossil_record = fossil_record;
				settings = settings;
				goal_type = goal_type; 
				genes = ref genes;  
				kingdom = kingdom;
				genotype_evaluator = ge} in
			close_in ic ;
			eco in
		
		let file_ok_sel filew ( ) =
			let ps_file =  filew#filename in
			eco_ref := open_from_in ps_file;
			filew#destroy( ) in
	
		let filew = GWindow.file_selection 
			~title:"Opening ecosystem" 
			~border_width:10  () in
		un (filew#ok_button#connect#clicked 
			~callback:(file_ok_sel filew));
		un (filew#cancel_button#connect#clicked 
			~callback:filew#destroy);
		filew#show()  
end	

open InOutEco		
let cols = new GTree.column_list
let max_inds = cols#add string
let lives = cols#add string
let deads = cols#add string
let unborns = cols#add string
let aidCol = cols#add string
let specFitCol = cols#add string
let expr_species = cols#add string
let bg = cols#add (unsafe_boxed (Gobject.Type.from_name "GdkColor"))

let create_model ( ) =
  let model = GTree.tree_store cols in
  model
let add_columns ~(view : GTree.view) ~model =
  let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
  List.iter 
  [("Avg Fitness", specFitCol);
  ("Max" , max_inds) ;  
  ("Alive" , lives) ;
  ("Dead", deads) ;
  ("Unborn", unborns); 
  ("Species ID" , expr_species);
  ("Species Ancestor ID", aidCol)]
  
  ~f: (fun (title, col) -> 
			let col_view = GTree.view_column ~title
			~renderer:(renderer, [("text", col)]) ( ) in
			col_view#add_attribute renderer "background-gdk" bg;
			un(view#append_column col_view))			

type modelSettings = ShowIncompleteProofs 
	| SortProofs of (species_info -> species_info -> int) 
	| SolutionHandle of (ecosystem->unit)
let updateModel ?(debug=false) eco ~(model : GTree.tree_store) settings = 
		let g_pop = !(eco.genes) in
		let ctx = !(g_pop.ctx) in
		begin try let iter = model#iter_children ~nth:0 None in
			let remove = ref (model#remove iter) in
			while !remove do
				remove := model#remove iter 
			done
		with _->( ) end;
		
		
		if List.exists (function SolutionHandle _ -> true |_->false) settings
		then(
			if List.length eco.solutions > 0 then (
			match (find (function SolutionHandle _ -> true |_->false) settings)
			with SolutionHandle handle -> handle eco
			|_->raise Not_found)
			 (*gene_window eco.genes 
			 [	ShowOnlySubset (List.map (fun te -> Te(te, None)) eco.solutions);
				DisplayEvaluate ])*));		
		let spec_pop_pairs = Hashtbl.fold 
		(fun species pop acc -> (species,pop) :: acc) eco.kingdom [] in
		
		let spec_pop_pairs = 
			if List.exists (function ShowIncompleteProofs->true |_->false) settings 
			then spec_pop_pairs
			else List.filter (fun (species,_) -> Proof.is_complete species) spec_pop_pairs in	
		let spec_pop_pairs = 
			if List.exists (function SortProofs _ ->true |_->false) settings 
			then (
				let sort = 
					match find (function SortProofs _ ->true |_->false) settings
					with SortProofs pf -> (fun (_, pop1) (_, pop2) -> 
						pf pop1.info pop2.info)
					| _-> raise Not_found in
				List.fast_sort sort spec_pop_pairs)
			else spec_pop_pairs in
		
		
		
		ListLabels.iter spec_pop_pairs
		~f:(fun (species , population) ->
			let row = model#append ( ) in 
			let set column = model#set ~row ~column in 
			let color str = set bg (GDraw.color (`NAME str)) in
			
			if population.contains_solution 
				then color "yellow"
				else color "blue";
			
			List.iter ~f:(fun (str, column) -> model#set ~row ~column str)
			([(string_of_float (population.info.avgFitness), specFitCol);
			((string_of_int (population.info.species_id)) , expr_species)  ;
			((match population.info.ancestor_species_id with 
				|None -> "--"
				| Some id ->string_of_int id), aidCol)] @
		
			(List.map (fun (pred, col) -> string_of_int (card_population ~pred population), col) 
			[((fun _ -> true), max_inds); 
			((function Alive _ -> true |_->false), lives);
			((function Dead _ -> true |_->false), deads);
			((function Unborn  -> true |_->false), unborns)]));		
						
			Hashtbl.iter (fun genotype ->
				function
					|Alive ev -> 
						let row = model#append ~parent:row () in 
						let set column = model#set ~row ~column in 
						let color str = set bg (GDraw.color (`NAME str)) in
						color "orange";
						set lives (string_of_float ev);
						set expr_species (ProoProg.string_of_program  g_pop (species, genotype))
					|_ -> ( )) population.genotypes)


let on_row_activated ?(debug=false) eco (view:GTree.view) path column = 
	let model = view#model in
	let row = model#get_iter path in
	let str = model#get ~row ~column:expr_species in
	try 
		let id = int_of_string str in
		let species = get_species_from_id !eco id in
		prf ~filename:(Some "tree.dot") (string_of_proof  ~output:"dot" !(!(!eco.genes).ctx) species);
		command "dot -Tgif tree.dot -o out.gif | mspaint out.gif"
	with
	|_->
		let g_pop = !(!eco.genes) in
		let ctx = !(g_pop.ctx) in
	try
		show_expr_window ctx  (ExpressionString str) ( )
	with _-> prf "\n failed"


(*Test cases  and GoalType loading ****************************)			
let openLast = ref None
let testCases_filename = ref None

let readCases ps_file ~(gp : ecosystem ref) ~(gpSettings:ecoSetting) callb =
	let ctxRef = (!(!gp.genes)).ctx in
	let (cases, ty) = read_test_cases ps_file !ctxRef in
	gp := make_ecosystem (ref (make_gene_pool ctxRef)) ty (TestCases cases) gpSettings;
	(match !openLast with
	|Some fsett -> 
		let oc = open_out fsett in
		output_string oc (Filename.dirname ps_file ^ "\\\n"); close_out oc
	|_->( ));
	callb ps_file 
let file_ok_sel filew ~(gp : ecosystem ref) ~(gpSettings:ecoSetting) callb ( )= 	
	let ps_file =  filew#filename in
	readCases ps_file ~gp ~gpSettings callb;
	filew#destroy( )
	
	
	    
type population_window_setting = Auto | ProofDepth of int | BlocPopInitComplexity of int 
| LoadCasesOnOpen of string | OpenFileDlgPathGP of string | GenePrecision of int 
|PopSize of int | MaxGeneSize of int | MaxProofWidth of int			
let make_population_visual ?(debug=false) refCtx settings =
	match !refCtx with 
	| [] -> failwith "Can not start GP until initial context is loaded\n" 
	| _  -> 
	
	(*Window settings***************)
	let window = GWindow.window ~title:"population" () in
		window#set_default_size ~width:950 ~height:700;
    
	let hBox = GPack.hbox ~packing:window#add () in
	let leftPanel = GPack.vbox 
		~border_width:8 
		~height:350 
		~width:500 
		~spacing:8 
		~packing:hBox#add () in    
    
    (*space for program listing *)
	let sw_progs, model = 
	GBin.scrolled_window 
		~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC 
		~vpolicy:`AUTOMATIC ~packing:leftPanel#add (), 
	create_model ( ) in
    
    let view = GTree.view ~model:model ~packing:sw_progs#add () in 
	view#set_rules_hint true; 
	view#selection#set_mode `MULTIPLE; 
	add_columns ~view ~model;
	
	
    let boxMenu = GPack.vbox ~width:80 ~packing:hBox#add () in
    
    
    (*Window items generators ***********************************)
	let panel ?(box = boxMenu) title = 
		let pan = GBin.frame ~label:(title^ "...") ~packing:box#pack ( ) in
		GPack.vbox ~width:80 ~packing:pan#add ( ) in
	let empty_entry ?(editable=false) ?(text="") packer ( ) = 
    GEdit.entry ~editable ~text  ~width:100  ~packing:packer#add ( ) in
	let button str packer ( ) = GButton.button ~label:str ~packing:packer#add () in
    
	
	
	(*Panels **********************************)
	let controlPanel, genePoolPanel, testCasePanel,
	proofPanel, gpPanel = 
		panel "Tools...",
		panel "Gene pool..." ,
		panel "Test cases...",
		panel "Proofs...",
		panel "gp..." in 
    	
    (*Buttons **********************************)	
	let update_btn, save_eco_btn, open_blocks_btn, 
	init_first_generation_btn, open_eco_btn= 
		button "Update labels" controlPanel ( ),
		button "Save Ecosystem" controlPanel ( ),  
		button "View blocks" genePoolPanel ( ), 
		button "Next generation" gpPanel ( ),
		button "Open eco" controlPanel ( ) in 

    let num_elt_label, tot_complexity_label, 
    precision_label, max_size_label, file_name_label, 
    goal_type_label  = 
		empty_entry genePoolPanel ( ),
		empty_entry genePoolPanel ( ),
		empty_entry genePoolPanel ( ),
		empty_entry genePoolPanel ( ), 
		empty_entry testCasePanel ( ),
		empty_entry testCasePanel ( ) in 
    
        
    let proof_num_label, proofView_button, prog_label = 
    empty_entry ~text:"No proofs" proofPanel ( ),
    button "View selected proof" proofPanel ( ),
	empty_entry ~text:"No programs possible" proofPanel ( ) in
    let show_all_proofs = GButton.check_button  
				~label:"Show all" 
				~active:false
				~packing:proofPanel#add ( ) in  

	(*Parameters  ******************************)
	let genePoolStepComplexity, precision, 
	proofDepth, popSize, mgSize, 
	maxProofWidth, auto = 
	(fold_left (fun default_val -> function
		BlocPopInitComplexity comp->comp
		|_->default_val) 10000 settings), 
	(fold_left (fun default_val -> function
		GenePrecision pre  -> pre
		|_->default_val) 5 settings),
	(fold_left (fun default_val -> function
		ProofDepth pd -> pd
		|_->default_val) 3 settings),
	(fold_left (fun default_val -> function
		PopSize pd -> pd
		|_->default_val) 1000 settings),
	(fold_left (fun default_val -> function
		MaxGeneSize mg ->mg
		|_->default_val) 30 settings),
	(fold_left (fun default_val -> function
		MaxProofWidth mpw -> mpw
		|_->default_val) 5 settings),
	List.exists (function Auto -> true |_->false) settings in   
    let gpSettings = {
			maxProofWidth = maxProofWidth;
			aprGenePoolTotComp=genePoolStepComplexity;
			aprNumberOfLiveGenotypes=popSize;
			(*Sel_1*) elitismSize = 5;
			selectSize = 40;
			selectReap = 40 } in
	let constrFunc = (fun _ expr-> complexity_of_expr expr < mgSize) in
    let population_live_label, population_dead_label, generationLabel = 
	empty_entry  gpPanel ( ),
	empty_entry  gpPanel ( ), 
	empty_entry  gpPanel ( ) in   
	

	let sw_stats = 
	GBin.scrolled_window 
		~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC 
		~vpolicy:`AUTOMATIC ~packing:gpPanel#add () in
	let stats_text = GText.view 
			~width:350 
			~height:200 
			~border_width:3 
			~wrap_mode:`WORD
			~packing:sw_stats#add( ) 	in 	


	let gp = ref (make_ecosystem 
		~debug:false 
		 (ref (make_gene_pool refCtx)) TyUnit (evaluation_function (!refCtx)) gpSettings) in
	
	let update ?(before = fun () -> ( )) ( ) = 
		before ( );
		let genes = !(!gp.genes) in
		let ctx = !(genes.ctx) in
	
		List.iter (fun (a,b) -> a#set_text b)
		[(generationLabel, ("Generation " ^ string_of_int !gp.generation_count));
		(population_live_label, ("Evaluated programs : " ^ 
		string_of_int (card_ecosystem ~pred:(function Alive _ ->true |_->false) !gp)))];
	
		goal_type_label#set_text ("Goal type is " ^ string_of_type ctx !gp.goal_type Compact);
		let proofs = (keys !gp.kingdom) in
			(proof_num_label#set_text 
				("There are " ^ string_of_int (List.length proofs) ^ " proofs in the system"));
		prog_label#set_text 
				("There are " ^ 
				string_of_int (prog_num genes proofs) ^ " possible programs");
		
		stats_text#buffer#set_text !gp.stats;	
		updateModel ~debug !gp ~model 
		(if show_all_proofs#active then [ShowIncompleteProofs] else [ ]);
		
		
		List.iter2 (fun a b -> a#set_text b)
		[num_elt_label;tot_complexity_label;max_size_label]
		["There are " ^ string_of_int (gene_count  !(!gp.genes)) ^ " elts in the pool";
		"Total complexity is " ^ string_of_int (comp !(!gp.genes)) ;
		(*"The precision is at " ^ string_of_int !refGene_pool.terms.precision ; *)
		"The max size of a spawned gene is " ^ string_of_int mgSize] in
	
		
	un(show_all_proofs#connect#toggled  ~callback:update);
	let callb filename = 
		testCases_filename := Some filename;
		file_name_label#set_text filename;
		update( ) in		
	
		
   
    let show_proofs( ) = 
		let selection = view#selection in
		let selectedRows = selection#get_selected_rows in
		let path = List.hd selectedRows in
		let row = model#get_iter path in
		let str = model#get ~row ~column:expr_species in
		try 
			let id = int_of_string str in
			let species = get_species_from_id !gp id in
			make_proof_visual !gp (id, species)
		with
		|_->( ) in	
    let show_genes ( ) =
		gene_window !gp.genes
		[ShowGrowByOne ; 
		ShowGrowByComp genePoolStepComplexity ; 
		MaxSize mgSize] in
	let init_first_generation ( ) = 
		next_generation !gp constrFunc;
		update ( ) in
    

    
	
	(*Button connects ***********************************************)
	un(update_btn#connect#clicked ~callback:update);
	un(view#connect#row_activated ~callback:(on_row_activated ~debug gp view));
    un(proofView_button#connect#clicked ~callback:show_proofs);
	un(open_blocks_btn#connect#clicked ~callback:show_genes);
	un(save_eco_btn#connect#clicked ~callback:(save_eco  !gp));
  	un(init_first_generation_btn#connect#clicked ~callback:(init_first_generation));
	un(open_eco_btn#connect#clicked ~callback:(update ~before:(open_eco gp)));
	
		
	if auto then (
		gene_window !gp.genes
		[Hide; BuildInit genePoolStepComplexity; 
			MaxSize mgSize];
		init_first_generation ( ));
	window#show()
